home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / halcn305.zip / GSOB_NDX.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-24  |  37KB  |  1,265 lines
  1. unit GSOB_Ndx;
  2. {-----------------------------------------------------------------------------
  3.                             dBase III Index Handler
  4.  
  5.        GSOB_Ndx Copyright (c)  Richard F. Griffin
  6.  
  7.        08 February 1993
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This unit handles the objects for all dBase III index (.NDX)
  14.        operations.
  15.  
  16.    Changes:
  17.  
  18.       17 Apr 93 - KeySort routine corrected to handle key string lengths
  19.                   properly.  Prior to fix, all numeric keys defaulted to
  20.                   length 8, which caused key truncation in cases where the
  21.                   actual length was greater.  Fix involves passing the real
  22.                   length as part of the argument instead of using Key_Lgth.
  23.  
  24.       02 May 93 - Routines used for conversion to/from numbers have been
  25.                   modified to be of type FloatNum.  This allows numbers to
  26.                   have up to 20 significant digits.  Note that the $N+ and
  27.                   $E+ switches must be set (Alt O,C,8,E in IDE) to compile
  28.                   using this feature.  Otherwise, 11-12 digits will be used.
  29.                   The use of the $N+,E+ switch adds 10K to program size.
  30.  
  31.                   When you compile a program in the $N+,E+ state, the
  32.                   compiler links with the full 80x87 emulator.  The resulting
  33.                   .EXE file can be run on any machine, regardless of whether
  34.                   that machine has an 80x87. If an 80x87 is present, the
  35.                   program will use it; otherwise, the run-time library
  36.                   emulates it.  This gives you access to four additional
  37.                   real types: Single, Double, Extended, and Comp.  The $E+
  38.                   directive will emulate the 80x87. This gives you access
  39.                   to the IEEE floating-point types without requiring that you
  40.                   install an 80x87 chip.
  41.  
  42.       09 Jun 93 - Altered KeyUpdate to test for successful record lock.  It
  43.                   previously 'assumed' locking was successful.
  44.  
  45.       11 Jun 93 - Major modification to resolve index updates.  Programs
  46.                   would hang with indexes greater than 500K size.
  47.  
  48.       10 Jul 93 - Extended size of GSR_InxDataBlk entry Data_Ary to include
  49.                   the fill area.  This was needed to prevent range check err.
  50.  
  51.       15 Jul 93 - Fixed bug in IndxStore to properly update the root node
  52.                   pointer.  Thanks to the 11 Jun 93 update, the header
  53.                   information was not written to the file at the end of
  54.                   index building process.
  55.  
  56.       16 Jul 93 - Fixed bug in NodeEntryDelete that caused an invalid node
  57.                   current entry number when the last key element in the node
  58.                   was deleted.
  59.  
  60. ------------------------------------------------------------------------------}
  61.  
  62. interface
  63.  
  64. uses
  65.  
  66.    GSOB_Var,
  67.    GSOB_Dte,
  68.    GSOB_Str,                          {String handler routines}
  69.    GSOB_Inx,
  70.    GSOB_Dsk,                          {File handler routines}
  71.    GSOB_DBF,
  72.    {$IFOPT N-}
  73.       GSOB_Flp,                       {Used if 80x87 not selected}
  74.    {$ENDIF}
  75.    {$IFDEF WINDOWS}
  76.       Objects;
  77.    {$ELSE}
  78.       GSOB_Obj;
  79.    {$ENDIF}
  80.  
  81. const
  82.  
  83.    NdxBlokSize = 512;
  84.  
  85. type
  86.  
  87.    LastUpdateAction = (AtLeaf,NoChange,LastChanged,Empty,Expanded);
  88.  
  89.    GSP_InxHeader  = ^GSR_InxHeader;
  90.    GSR_InxHeader  = Record
  91.       Root        : Longint;
  92.       Next_Blk    : Longint;
  93.       Unknwn1     : Longint;
  94.       Key_Lgth    : Integer;
  95.       Max_Keys    : Integer;
  96.       Data_Typ    : Integer;
  97.       Entry_Sz    : Integer;
  98.       Unknwn2     : Longint;
  99.       Key_Form    : array [0..NdxBlokSize-25] of char;
  100.    end;
  101.  
  102.    GSP_InxDataBlk  = ^GSR_InxDataBlk;
  103.    GSR_InxDataBlk  = Record
  104.       Entry_Ct     : Integer;
  105.       Unknwn1      : Integer;
  106.       Data_Ary     : array [0..NdxBlokSize+255] of byte; {Array of key entries}
  107.                                                          {plus overflow area}
  108.    end;
  109.  
  110.    GSP_InxElement = ^GSR_InxElement;
  111.    GSR_InxElement = Record
  112.       Block_Ax  : Longint;
  113.       Recrd_Ax  : Longint;
  114.       Char_Fld  : array [1..255] of char;
  115.    end;
  116.  
  117.    GSP_IndexFile   = ^GSO_IndexFile;
  118.    GSP_InxNode = ^GSO_InxNode;
  119.  
  120.    GSP_InxTable = ^GSO_InxTable;
  121.    GSO_InxTable = Object(TCollection)
  122.       ixLink      : GSP_IndexFile;
  123.       Elements    : array[0..(NdxBlokSize div 12)+1] of GSP_InxElement;
  124.       constructor Init(ILink : GSP_IndexFile);
  125.       function    FetchBttm : pointer;
  126.       function    FetchCurr : pointer;
  127.       function    FetchNext : pointer;
  128.       function    FetchPrev : pointer;
  129.       function    FetchTop  : pointer;
  130.       procedure   NodeEntryDelete(en : integer);
  131.       procedure   NodeEntryInsert(en : integer; wkey: string;
  132.                                   wb, wr: longint);
  133.       function    NodeGet(pn : longint) : pointer;
  134.       procedure   WriteAllNodes(actn: LastUpdateAction);
  135.       procedure   ReleaseNode(p: GSP_InxNode);
  136.       procedure   ReleaseAllNodes;
  137.    end;
  138.  
  139.    GSO_InxNode = Object(TObject)
  140.       tbLink      : GSP_InxTable;   {Link to collection owner}
  141.       IndxBufr    : GSP_InxDataBlk;
  142.       Page_No     : Longint;   {Disk block holding node info}
  143.       Etry_No     : Integer;   {Last entry used in node}
  144.       ItemCount   : Integer;   {Number of keys in this node }
  145.       NonLeaf     : Boolean;   {True for non-leaf nodes}
  146.       Changed     : boolean;
  147.       ChgLastEtry : boolean;
  148.       constructor Init(CLink : GSP_InxTable; pn : longint);
  149.       destructor  Done; virtual;
  150.       procedure   Retrieve;
  151.    end;
  152.  
  153.    GSO_IndexFile   = object(GSO_DiskFile)
  154.       ixColl       : GSP_IndxColl;
  155.       ixKey_St     : ixKeyString;     {Holds last key value found}
  156.       ixKey_Num    : longint;         {Holds last physical record number}
  157.       IxKey_Form   : string[255];     {Holds the key formula in type string}
  158.       ixKey_Siz    : integer;
  159.       ixKey_Typ    : char;
  160.       ixBOF        : boolean;
  161.       ixEOF        : boolean;
  162.       ixFollowKey  : boolean;         {Flag to follow key for next read when}
  163.                                       {the key is modified.  If false, the }
  164.                                       {next record from the old key position }
  165.                                       {is read.  If true, the next record from}
  166.                                       {the new key position is read.  Default}
  167.                                       {is false}
  168.       tbLink       : GSP_InxTable;
  169.       Ndx_Hdr      : GSR_InxHeader;
  170.       Key_Lgth     : Integer;
  171.       Max_Keys     : Integer;
  172.       Entry_Sz     : Integer;
  173.       CurrNode     : GSP_InxNode;
  174.       CurrElmt     : GSP_InxElement;  {Pointer to key entry information}
  175.       CacheBuf     : PByteArray;
  176.       CacheBlok    : word;
  177.       Constructor Init(IName : string);
  178.       Constructor NewInit(filname,formla: string; lth,dcl: integer; typ: char);
  179.       Destructor  Done; virtual;
  180.       Procedure   IndxClear; virtual;
  181.       Procedure   IndxStore(p : GSP_IndxColl; recnode : boolean); virtual;
  182.       Function    KeyFind(st : String) : longint; virtual;
  183.       Procedure   KeyList(st : string); virtual;
  184.       Function    KeyLocRec(rec : longint) : boolean; virtual;
  185.       Function    KeyRead(a : LongInt) : longint; virtual;
  186.       Procedure   KeySort(kl : integer; sa : SortStatus); virtual;
  187.       Procedure   KeyUpdate(rec: longint; st: string; Apnd: boolean); virtual;
  188.       Function    Ndx_AdjVal(st : string): string;
  189.       Procedure   Ndx_Close;
  190.       Procedure   Ndx_Flush;
  191.       Procedure   Ndx_GetHdr;
  192.       Function    Ndx_NextBlock : longint;
  193.       Procedure   Ndx_PutHdr;
  194.       Function    Ndx_Root : Longint;
  195.       Procedure   WriteStatus(RNum : longint); virtual;
  196.    end;
  197.  
  198. var
  199.    Ndx_Data : GSR_InxDataBlk;
  200.  
  201.  
  202. implementation
  203.  
  204.  
  205. const
  206.  
  207.    AccessTries  : word = 1000;  {Attempts to access file before stop}
  208.    Same_Record = -5;            {Token value passed to read the same record}
  209.  
  210. var
  211.    SaveKey1 : GSR_InxElement;
  212.    SaveKey2 : GSR_InxElement;
  213.  
  214.    Work_Key : string;               {Holds key passed in Find and KeyUpdate}
  215.    RPag     : Longint;              {Work variable to hold current index block}
  216.    RNum     : Longint;              {Work variable for record number}
  217.    IsAscend : Boolean;              {Flag for ascending/descending status.}
  218.                                     {Set based on Next/Previous Record read}
  219.  
  220.  
  221. {$IFOPT N+}
  222. {------------------------------------------------------------------------------
  223.                     Conversion/Comparison of Number Fields
  224.                     Used when The $N switch is set '+'
  225. ------------------------------------------------------------------------------}
  226.  
  227. type
  228.    gsDouble = Double;
  229.  
  230. procedure MakeDouble(C_String: string;var dtype: Double;var rcode : word);
  231. begin
  232.    val(C_String,dtype,rcode);
  233. end;
  234.  
  235. function CmprDouble(var val1, val2) : integer;
  236. var
  237.    v1       : Double absolute val1;
  238.    v2       : Double absolute val2;
  239. begin
  240.    if v1 = v2 then CmprDouble := 0
  241.       else if v1 < v2 then CmprDouble := -1
  242.          else CmprDouble := 1;
  243. end;
  244.  
  245. function CnvrtDouble(var dtype) : string;
  246. var
  247.    dbl_in : Double absolute dtype;
  248.    st     : string;
  249. begin
  250.    str(dbl_in,st);
  251.    CnvrtDouble := st;
  252. end;
  253. {$ENDIF}
  254.  
  255. {------------------------------------------------------------------------------
  256.                                GSO_InxTable
  257. ------------------------------------------------------------------------------}
  258.  
  259. constructor GSO_InxTable.Init(ILink : GSP_IndexFile);
  260. var
  261.    i  : integer;
  262. begin
  263.    TCollection.Init(32,16);
  264.    for i := 0 to ILink^.Max_Keys+2 do
  265.       Elements[i] := Addr(Ndx_Data.Data_Ary[(i *  ILink^.Entry_Sz)]);
  266.    ixLink := ILink;
  267. end;
  268.  
  269. function GSO_InxTable.FetchBttm : pointer;
  270. var
  271.    p  : GSP_InxNode;
  272.    e  : GSP_InxElement;
  273. begin
  274.    ReleaseAllNodes;
  275.    p := NodeGet(ixLink^.Ndx_Root);
  276.    e := Elements[p^.ItemCount-1];
  277.    while p^.NonLeaf and (p^.ItemCount > 0) do
  278.    begin
  279.       p^.Etry_No := p^.ItemCount;
  280.       if p^.ItemCount > 0 then dec(p^.Etry_No);
  281.       p := NodeGet(e^.Block_Ax);
  282.       if p^.ItemCount > 0 then e := Elements[p^.ItemCount-1] else e := nil;
  283.    end;
  284.    p^.Etry_No := p^.ItemCount;
  285.    if p^.ItemCount > 0 then dec(p^.Etry_No);
  286.    FetchBttm := e;
  287. end;
  288.  
  289. function GSO_InxTable.FetchCurr : pointer;
  290. var
  291.    p  : GSP_InxNode;
  292. begin
  293.    p := Items^[Count-1];
  294.    p^.Retrieve;
  295.    FetchCurr := Elements[p^.Etry_No];
  296. end;
  297.  
  298. function GSO_InxTable.FetchNext : pointer;
  299. var
  300.    p  : GSP_InxNode;
  301.    e  : GSP_InxElement;
  302. begin
  303.    if Count = 0 then
  304.    begin
  305.       FetchNext := nil;
  306.       exit;
  307.    end;
  308.    p := Items^[Count-1];
  309.    p^.Retrieve;
  310.    inc(p^.Etry_No);
  311.    if p^.Etry_No < p^.ItemCount then         {Get next in leaf node}
  312.       FetchNext := Elements[p^.Etry_No]
  313.    else
  314.    begin                                 {Search NonLeaf Nodes}
  315.       while (p^.Etry_No >= p^.ItemCount) and (Count <> 1) do
  316.       begin
  317.          ReleaseNode(p);
  318.          p := Items^[Count-1];
  319.          p^.Retrieve;
  320.          inc(p^.Etry_No);
  321.       end;
  322.  
  323.       if (p^.Etry_No >= p^.ItemCount) then
  324.       begin                 {At EOF, restore back to last valid record}
  325.          dec(p^.Etry_No);
  326.          while p^.NonLeaf do
  327.          begin
  328.             e := Elements[p^.Etry_No];
  329.             p := NodeGet(e^.Block_Ax);
  330.             p^.Etry_No := p^.ItemCount-1;
  331.          end;
  332.          FetchNext := nil;
  333.       end
  334.       else                  {Get next available leaf node}
  335.       begin
  336.          e := Elements[p^.Etry_No];
  337.          while p^.NonLeaf do
  338.          begin
  339.             p := NodeGet(e^.Block_Ax);
  340.             p^.Etry_No := 0;
  341.             if p^.ItemCount > 0 then e := Elements[0] else e := nil;
  342.          end;
  343.          FetchNext := e;
  344.       end;
  345.    end;
  346. end;
  347.  
  348. function GSO_InxTable.FetchPrev : pointer;
  349. var
  350.    p  : GSP_InxNode;
  351.    e  : GSP_InxElement;
  352. begin
  353.    if Count = 0 then
  354.    begin
  355.       FetchPrev := nil;
  356.       exit;
  357.    end;
  358.    p := Items^[Count-1];
  359.    p^.Retrieve;
  360.    dec(p^.Etry_No);
  361.    if p^.Etry_No >= 0 then         {Get next in leaf node}
  362.       FetchPrev := Elements[p^.Etry_No]
  363.    else
  364.    begin                           {Search nonleafnodes}
  365.       while (p^.Etry_No < 0) and (Count <> 1) do
  366.       begin
  367.          ReleaseNode(p);
  368.          p := Items^[Count-1];
  369.          p^.Retrieve;
  370.          dec(p^.Etry_No);
  371.       end;
  372.       if (p^.Etry_No < 0) then
  373.       begin
  374.          inc(p^.Etry_No);
  375.          while p^.NonLeaf do
  376.          begin
  377.             e := Elements[p^.Etry_No];
  378.             p := NodeGet(e^.Block_Ax);
  379.             p^.Etry_No := 0;
  380.          end;
  381.          FetchPrev := nil;
  382.       end
  383.       else
  384.       begin
  385.          e := Elements[p^.Etry_No];
  386.          while p^.NonLeaf do
  387.          begin
  388.             p := NodeGet(e^.Block_Ax);
  389.             p^.Etry_No := p^.ItemCount-1;
  390.             if p^.ItemCount > 0 then e := Elements[p^.ItemCount-1]
  391.                else e := nil;
  392.          end;
  393.          FetchPrev := e;
  394.       end;
  395.    end;
  396. end;
  397.  
  398. function GSO_InxTable.FetchTop : pointer;
  399. var
  400.    p  : GSP_InxNode;
  401.    e  : GSP_InxElement;
  402.    n  : longint;
  403. begin
  404.    ReleaseAllNodes;
  405.    p := NodeGet(ixLink^.Ndx_Root);
  406.    e := Elements[0];
  407.    while p^.NonLeaf and (p^.ItemCount > 0) do
  408.    begin
  409.       n := p^.Page_No;
  410.       p^.Etry_No := 0;
  411.       p := NodeGet(e^.Block_Ax);
  412.       if p^.ItemCount <= 0 then e := nil;
  413.    end;
  414.    p^.Etry_No := 0;
  415.    FetchTop := e;
  416. end;
  417.  
  418. procedure GSO_InxTable.NodeEntryDelete(en : integer);
  419. var
  420.    p  : GSP_InxNode;
  421. begin
  422.    p := Items^[Count-1];
  423.    p^.Retrieve;
  424.    Move(Elements[en+1]^,Elements[en]^,ixLink^.Entry_Sz*(p^.ItemCount-en));
  425.    dec(Ndx_Data.Entry_Ct);
  426.    move(Ndx_Data, p^.IndxBufr^,SizeOf(Ndx_Data));
  427.    dec(p^.ItemCount);
  428.    p^.ChgLastEtry := p^.ItemCount = en;
  429.    if p^.ChgLastEtry then dec(p^.Etry_No);
  430.    p^.Changed := true;
  431. end;
  432.  
  433. procedure GSO_InxTable.NodeEntryInsert
  434.                                 (en : integer; wkey: string; wb,wr: longint);
  435. var
  436.    p  : GSP_InxNode;
  437.    e  : GSP_InxElement;
  438. begin
  439.    p := Items^[Count-1];
  440.    p^.Retrieve;
  441.    e := Elements[en];
  442.    Move(Elements[en]^,Elements[en+1]^,ixLink^.Entry_Sz*(p^.ItemCount-en));
  443.    move(wkey[1],e^.Char_Fld,ixLink^.Key_Lgth);
  444.    e^.Block_Ax := wb;
  445.    e^.Recrd_Ax := wr;
  446.    inc(Ndx_Data.Entry_Ct);
  447.    move(Ndx_Data, p^.IndxBufr^,SizeOf(Ndx_Data));
  448.    p^.ChgLastEtry := p^.ItemCount = en;
  449.    inc(p^.ItemCount);
  450.    p^.Changed := true;
  451. end;
  452.  
  453. function GSO_InxTable.NodeGet(pn : longint) : pointer;
  454. var
  455.    p  : GSP_InxNode;
  456.       nlt : longint;
  457.       nlb : longint;
  458. begin
  459.    p := New(GSP_InxNode, Init(@Self, pn));
  460.    Insert(p);
  461.    p^.Retrieve;
  462.    NodeGet := p;
  463. end;
  464.  
  465. procedure GSO_InxTable.WriteAllNodes(actn: LastUpdateAction);
  466. var
  467.    p  : GSP_InxNode;
  468.    e  : GSP_InxElement;
  469.    ar : LastUpdateAction;
  470.  
  471.    Procedure WriteNode(pn : longint);
  472.    begin
  473.       ixLink^.Write(pn*NdxBlokSize,Ndx_Data,NdxBlokSize);
  474.    end;
  475.  
  476.    Procedure MakeRootNode;
  477.    begin
  478.       ixLink^.Ndx_Hdr.Root := ixLink^.Ndx_NextBlock;
  479.                                           {Set root pointer to this block.}
  480.       ixLink^.Ndx_PutHdr;                 {Write updated header block.}
  481.       FillChar(Ndx_Data, SizeOf(Ndx_Data),#0);
  482.       move(SaveKey1,Elements[0]^,ixLink^.Entry_Sz);
  483.       move(SaveKey2,Elements[1]^,ixLink^.Entry_Sz);
  484.       Ndx_Data.Entry_Ct := 1;
  485.       WriteNode(ixLink^.Ndx_Hdr.Root);
  486.    end;
  487.  
  488.    Procedure SplitBlock;
  489.    var
  490.       b1   : longint;
  491.       e1   : integer;
  492.       e2   : integer;
  493.  
  494.    begin
  495.       b1 := ixLink^.Ndx_NextBlock;        {Get the next available block.}
  496.       e1 := (p^.ItemCount) shr 1;         {Number of entries in first half.}
  497.       e2 := (p^.ItemCount) - e1;          {Number of entries in second half.}
  498.       Ndx_Data.Entry_Ct := e1;
  499.       if p^.NonLeaf then dec(Ndx_Data.Entry_Ct);
  500.       WriteNode(p^.Page_no);
  501.       move(Elements[e1-1]^,SaveKey1,ixLink^.Entry_Sz);
  502.       SaveKey1.Block_Ax := p^.Page_No;
  503.       SaveKey1.Recrd_Ax := 0;
  504.       Ndx_Data.Entry_Ct := e2;
  505.       if p^.NonLeaf then dec(Ndx_Data.Entry_Ct);
  506.       move(Elements[e1]^,Ndx_Data.Data_Ary[0],ixLink^.Entry_Sz*e2);
  507.                                           {Shift second half to beginning of}
  508.                                           {the buffer array.}
  509.       WriteNode(b1);
  510.       move(Elements[e2-1]^,SaveKey2,ixLink^.Entry_Sz);
  511.       SaveKey2.Block_Ax := b1;
  512.       SaveKey2.Recrd_Ax := 0;
  513.       ixLink^.Ndx_PutHdr;                 {Store from header info area}
  514.    end;
  515.  
  516. begin
  517.    if Count = 0 then exit;
  518.    p := Items^[Count-1];
  519.    p^.Retrieve;
  520.  
  521.    if actn = Expanded then
  522.    begin
  523.       e := Elements[p^.Etry_No];
  524.       move(SaveKey2,e^,8);
  525.       move(Elements[p^.Etry_No]^,Elements[p^.Etry_No+1]^,
  526.            ixLink^.Entry_Sz*(p^.ItemCount-p^.Etry_No));
  527.       move(SaveKey1,e^,ixLink^.Entry_Sz);
  528.       inc(Ndx_Data.Entry_Ct);
  529.       p^.ChgLastEtry := p^.ItemCount = p^.Etry_No;
  530.       inc(p^.ItemCount);
  531.       p^.Changed := true;
  532.    end;
  533.  
  534.    if actn = LastChanged then
  535.    begin
  536.       e := Elements[p^.Etry_No];
  537.       move(SaveKey1,e^,ixLink^.Entry_Sz);
  538.       p^.ChgLastEtry := p^.ItemCount-1 = p^.Etry_No;
  539.       p^.Changed := true;
  540.    end;
  541.  
  542.  
  543.    if p^.ItemCount = 0 then ar := Empty
  544.    else
  545.    begin
  546.       if Ndx_Data.Entry_Ct > ixLink^.Max_Keys then  {overflow condition?}
  547.       begin
  548.          SplitBlock;
  549.          ar := Expanded;
  550.       end
  551.       else
  552.       begin
  553.          if p^.Changed then
  554.             WriteNode(p^.Page_no);
  555.         if p^.ChgLastEtry  then
  556.          begin
  557.             move(Elements[p^.Etry_No]^,SaveKey1,ixLink^.Entry_Sz);
  558.             SaveKey1.Block_Ax := p^.Page_No;
  559.             SaveKey1.Recrd_Ax := 0;
  560.             ar := LastChanged;
  561.          end
  562.          else
  563.             ar := NoChange;
  564.       end;
  565.       ReleaseNode(p);
  566.       if Count > 0 then
  567.          WriteAllNodes(ar)
  568.       else
  569.          if ar = Expanded then MakeRootNode;
  570.     end;
  571. end;
  572.  
  573. procedure GSO_InxTable.ReleaseNode(p: GSP_InxNode);
  574. begin
  575.    Delete(p);
  576.    Dispose(p,Done);
  577. end;
  578.  
  579. procedure GSO_InxTable.ReleaseAllNodes;
  580. var
  581.    p  : GSP_InxNode;
  582. begin
  583.    while Count > 0 do
  584.    begin
  585.       p := Items^[Count-1];
  586.       ReleaseNode(p);
  587.    end;
  588. end;
  589.  
  590.  
  591. {------------------------------------------------------------------------------
  592.                                GSO_InxNode
  593. ------------------------------------------------------------------------------}
  594.  
  595. constructor GSO_InxNode.Init(CLink : GSP_InxTable; pn : longint);
  596. var
  597.    i : integer;
  598.    r : word;
  599. begin
  600.    IndxBufr := nil;
  601.    Page_No := pn;
  602.    Etry_No := -1;
  603.    ItemCount := 0;
  604.    NonLeaf := true;
  605.    tbLink := CLink;
  606.    Changed := false;
  607.    ChgLastEtry := false;
  608. end;
  609.  
  610. destructor GSO_InxNode.Done;
  611. begin
  612.    if IndxBufr <> nil then dispose(IndxBufr);
  613.    TObject.Done;
  614. end;
  615.  
  616. procedure GSO_InxNode.Retrieve;
  617. var
  618.    v : longint;
  619. begin
  620.    if IndxBufr = nil then
  621.    begin
  622.       New(IndxBufr);
  623.       tbLink^.ixLink^.Read(Page_No*NdxBlokSize,IndxBufr^,NdxBlokSize);
  624.    end;
  625.    move(IndxBufr^,Ndx_Data,SizeOf(Ndx_Data));
  626.    ItemCount := Ndx_Data.Entry_Ct;
  627.    move(Ndx_Data.Data_Ary[0],v,4);
  628.    NonLeaf := v <> 0;
  629.    if nonLeaf then inc(ItemCount);
  630. end;
  631.  
  632. {-----------------------------------------------------------------------------
  633.                                  GSO_IndexFile
  634. ------------------------------------------------------------------------------}
  635.  
  636. constructor GSO_IndexFile.Init(IName : string);
  637. var
  638.    i : integer;
  639. begin
  640.    GSO_DiskFile.Init(IName+'.NDX',dfReadWrite+dfSharedDenyNone);
  641.    dfFileFlsh := WriteFlush;
  642.    if dfFileExst then Reset(1)
  643.       else
  644.       begin
  645.          Error(dosFileNotFound,ndxInitError);
  646.          exit;
  647.       end;
  648.    Read(0,Ndx_Hdr,NdxBlokSize);
  649.    Key_Lgth := Ndx_Hdr.Key_Lgth;
  650.    Max_Keys := Ndx_Hdr.Max_Keys;
  651.    Entry_Sz := Ndx_Hdr.Entry_Sz;
  652.    move(Ndx_Hdr.Key_Form[0], ixKey_Form[1],241);
  653.    ixKey_Form[0] := #241;
  654.    ixKey_Form[0] := chr(pos(#0,ixKey_Form)-1);
  655.    ixKey_Form := TrimR(ixKey_Form);
  656.    ixKey_Form := TrimL(ixKey_Form);
  657.    ixKey_Siz := Key_Lgth;
  658.    ixBOF := false;
  659.    ixEOF := false;
  660.    ixKey_St := '';
  661.    ixKey_Num := 0;
  662.    ixFollowKey := false;
  663.    tbLink := New(GSP_InxTable, Init(@Self));
  664. end;
  665.  
  666. Constructor GSO_IndexFile.NewInit(filname, formla: string; lth, dcl: integer;
  667.                                   typ : char);
  668. var
  669.    i : integer;
  670. begin
  671.    GSO_DiskFile.Init(filname+'.NDX',dfReadWrite);
  672.    dfFileFlsh := WriteFlush;
  673.    Rewrite(1);
  674.    FillChar(Ndx_Hdr, SizeOf(Ndx_Hdr),#0);
  675.    Ndx_Hdr.Root := 1;
  676.    Ndx_Hdr.Next_Blk := 2;
  677.    case typ of
  678.       'D',
  679.       'F',
  680.       'N'  : begin
  681.                 Ndx_Hdr.Data_Typ := 1;
  682.                 lth := 8;
  683.              end;
  684.       else Ndx_Hdr.Data_Typ := 0;
  685.    end;
  686.    Ndx_Hdr.Key_Lgth := lth;
  687.    i := lth+8;
  688.    while (i mod 4) <> 0 do i := i + 1;
  689.    Ndx_Hdr.Max_Keys := ((SizeOf(Ndx_Hdr)-8) div i);
  690.    Ndx_Hdr.Entry_Sz := i;
  691.    CnvStrToAsc(formla,Ndx_Hdr.Key_Form, length(formla)+1);
  692.    Write(0,Ndx_Hdr,NdxBlokSize);
  693.    Key_Lgth := lth;
  694.    Max_Keys := Ndx_Hdr.Max_Keys;
  695.    Entry_Sz := Ndx_Hdr.Entry_Sz;
  696.    ixKey_Form := formla;
  697.    ixKey_Form := TrimR(ixKey_Form);
  698.    ixKey_Form := TrimL(ixKey_Form);
  699.    ixKey_Siz := Key_Lgth;
  700.    ixKey_Typ := typ;
  701.    ixBOF := false;
  702.    ixEOF := false;
  703.    ixKey_St := '';
  704.    ixKey_Num := 0;
  705.    ixFollowKey := false;
  706.    FillChar(Ndx_Data, SizeOf(Ndx_Data),#0);
  707.    Write(-1,Ndx_Data,NdxBlokSize);
  708.    tbLink := New(GSP_InxTable, Init(@Self));
  709. end;
  710.  
  711. Destructor GSO_IndexFile.Done;
  712. var
  713.    i : integer;
  714. begin
  715.    Ndx_Close;
  716.    GSO_DiskFile.Done;
  717. end;
  718.  
  719. Procedure GSO_IndexFile.IndxClear;
  720. var
  721.    i : integer;
  722. begin
  723.    Ndx_Flush;
  724.    Ndx_GetHdr;
  725.    Ndx_Hdr.Root := 1;
  726.    Ndx_Hdr.Next_Blk := 2;
  727.    Write(0,Ndx_Hdr,NdxBlokSize);
  728.    ixBOF := false;
  729.    ixEOF := false;
  730.    ixKey_St := '';
  731.    ixKey_Num := 0;
  732.    FillChar(Ndx_Data, SizeOf(Ndx_Data),#0);
  733.    Write(-1,Ndx_Data,NdxBlokSize);
  734.    Truncate(-1);
  735. end;
  736.  
  737. Procedure GSO_IndexFile.IndxStore(p: GSP_IndxColl; recnode: boolean);
  738. var
  739.    rc        : integer;
  740.    rl        : word;
  741.    dt        : longint;
  742.    ec        : longint;
  743.    mk        : integer;
  744.    rf        : GSP_IndxEtry;
  745.    rr        : GSP_IndxEtry;
  746.    sv        : string[100];
  747.    ixFiller  : array[0..NdxBlokSize+255] of byte;
  748.    ixData    : GSR_InxDataBlk absolute ixFiller;
  749.    ixPntr    : GSP_InxElement;
  750.    ixBlok    : longint;
  751.    NodeColl  : GSP_IndxColl;
  752.    DblNum    : gsDouble;
  753.  
  754.    procedure CacheWrite;
  755.    begin
  756.       move(ixData,CacheBuf^[CacheBlok],NdxBlokSize);
  757.       CacheBlok := CacheBlok+NdxBlokSize;
  758.       if CacheBlok >= NdxBlokSize*32 then
  759.       begin
  760.          Write(-1,CacheBuf^,CacheBlok);
  761.          CacheBlok := 0;
  762.       end;
  763.    end;
  764.  
  765.    procedure CollectNodes;
  766.    begin
  767.       ixData.Entry_Ct := rc;
  768.       if not recnode then dec(ixData.Entry_Ct);
  769.       CacheWrite;
  770.       FillChar(ixData, SizeOf(ixData),#0);
  771.       NodeColl^.InsertKey(ixBlok, rr^.KeyStr);
  772.       rc := 0;
  773.       inc(ixBlok);
  774.    end;
  775.  
  776. begin
  777.    mk := Max_Keys;
  778.    if recnode then
  779.    begin
  780.       ixBlok := 1;
  781.       GetMem(CacheBuf,NdxBlokSize*32);
  782.       Read(0,CacheBuf^,NdxBlokSize);    {Position to initial loc}
  783.    end
  784.    else
  785.    begin
  786.       inc(mk);
  787.       ixBlok := Ndx_NextBlock;
  788.    end;
  789.    CacheBlok := 0;
  790.    NodeColl := nil;
  791.    New(NodeColl, InitNode(ixColl));
  792.    rr := p^.RetrieveKey;
  793.    rc := 0;
  794.    ec := 0;
  795.    FillChar(ixData, SizeOf(ixData),#0);
  796.    while rr <> nil do
  797.    begin
  798.       rf := rr;
  799.       ixPntr :=  Addr(ixData.Data_Ary[rc*Entry_Sz]);
  800.       if ixKey_Typ = 'C' then
  801.          move(rr^.KeyStr[1],IxPntr^.Char_Fld[1],Key_Lgth)
  802.       else
  803.       begin
  804.          sv := rr^.KeyStr;
  805.          if ixKey_Typ = 'D' then
  806.          begin
  807.             dt := GS_Date_Juln(sv);
  808.             str(dt,sv);
  809.          end;
  810.          MakeDouble(sv,DblNum,rl);
  811.          move(DblNum,IxPntr^.Char_Fld[1],Key_Lgth);
  812.       end;
  813.       if recnode then
  814.       begin
  815.          IxPntr^.Recrd_Ax := rr^.Tag;
  816.          IxPntr^.Block_Ax := 0;
  817.       end
  818.       else
  819.       begin
  820.          IxPntr^.Recrd_Ax := 0;
  821.          IxPntr^.Block_Ax := rr^.Tag;
  822.       end;
  823.       inc(rc);
  824.       inc(ec);
  825.       WriteStatus(ec);
  826.       if rc >= mk then CollectNodes;
  827.       rr := p^.RetrieveKey;
  828.    end;
  829.    if rc > 0 then
  830.    begin
  831.       rr := rf;
  832.       CollectNodes;
  833.    end;
  834.    p^.EndRetrieve;
  835.    if CacheBlok > 0 then Write(-1,CacheBuf^,CacheBlok);
  836.    if ec > Max_Keys then IndxStore(NodeColl, false);
  837.    Dispose(NodeColl, Done);
  838.    if recnode then
  839.    begin
  840.       FreeMem(CacheBuf,NdxBlokSize*32);
  841.       Dispose(ixColl, Done);
  842.       Ndx_Hdr.Root := Ndx_NextBlock-1;
  843.       Ndx_PutHdr;
  844.       Ndx_Flush;
  845.    end;
  846. end;
  847.  
  848.  
  849. Function GSO_IndexFile.KeyFind(st : string) : LongInt;
  850. var
  851.    i         : integer;               {Work variable}
  852.    rl        : integer;               {Result code for Val procedure}
  853.    ct        : integer;               {Variable to hold BlockRead byte count}
  854.    IsEqual   : boolean;               {Flag to hunt for key match}
  855.    PNode     : longint;
  856.    Match_Cnd : integer;
  857.  
  858.    procedure StoreMatchValue;
  859.    begin
  860.       move(CurrElmt^.Char_Fld,ixKey_St[1],Key_Lgth);
  861.                                       {Move the key field to Ndx_Key_St.}
  862.       ixKey_St[0] := Work_Key[0];   {Now insert the length into Ndx_Key_St}
  863.    end;
  864.  
  865.    function DoMatchValue : integer;
  866.    begin
  867.       if ixKey_Typ = 'C' then    {Character key field}
  868.          Match_Cnd := StrCompare(ixKey_St, Work_Key)
  869.       else                            {Numeric key field}
  870.          Match_Cnd := CmprDouble(ixKey_St[1], Work_Key[1]);
  871.       DoMatchValue := Match_Cnd;
  872.    end;
  873.  
  874.    function SearchMatchValue(var Index: Integer): Boolean;
  875.    var
  876.       L,
  877.       H,
  878.       I,
  879.       C: Integer;
  880.    begin
  881.       SearchMatchValue := False;
  882.       L := 0;
  883.       H := CurrNode^.ItemCount - 1;
  884.       if (CurrNode^.NonLeaf) then dec(H);
  885.       while L <= H do
  886.       begin
  887.          I := (L + H) shr 1;
  888.          CurrElmt := tbLink^.Elements[I];
  889.          StoreMatchValue;
  890.          C := DoMatchValue;
  891.          if C < 0 then L := I + 1 else
  892.          begin
  893.             H := I - 1;
  894.             if C = 0 then SearchMatchValue := true;
  895.          end;
  896.       end;
  897.       CurrElmt := tbLink^.Elements[L];
  898.       StoreMatchValue;
  899.       Index := L;
  900.    end;
  901.  
  902. begin
  903.    tbLink^.ReleaseAllNodes;
  904.    ixKey_Num := 0;                    {Initialize}
  905.    ixKey_St := '';                    {Initialize}
  906.    Work_Key := Ndx_AdjVal(st);        {Set key comparison value}
  907.    RPag := Ndx_Root;                  {Get root node address}
  908.    PNode := -1;
  909.    ixEOF := true;
  910.    while RPag <> 0 do                 {While a non-leaf node, do this}
  911.    begin
  912.       CurrNode := tbLink^.NodeGet(RPag);
  913.       IsEqual := SearchMatchValue(i);
  914.       CurrNode^.Etry_No := i;
  915.       ixEOF := ixEOF and (i >= Ndx_Data.Entry_Ct);
  916.       CurrElmt := tbLink^.Elements[i];
  917.       PNode := RPag;
  918.       RPag := CurrElmt^.Block_Ax;
  919.    end;
  920.    if IsEqual then
  921.       ixKey_Num := CurrElmt^.Recrd_Ax else ixKey_Num := 0;
  922.    KeyFind := ixKey_Num;              {Return with the record number}
  923. end;
  924.  
  925. Procedure GSO_IndexFile.KeyList(st : string);
  926. var
  927.    ofil      : text;
  928.    RPag      : LongInt;
  929.    i,j,k,v   : integer;
  930.    rl        : integer;
  931.    ct        : integer;
  932.    recnode,
  933.    Less_Than : boolean;
  934.    WorkNode  : GSP_InxNode;
  935.    Next_Blk  : Longint;
  936. begin
  937.    Next_Blk := Ndx_NextBlock;
  938.    System.assign(ofil, st);
  939.    System.ReWrite(ofil);
  940.    writeln(ofil,'--------------------------------------------------');
  941.    writeln(ofil,'File Name = ',dfFileName);
  942.    writeln(ofil,'Key Expression = ',ixKey_Form);
  943.    writeln(ofil,'Key Length = ',Key_Lgth,
  944.                 '   Maximum Keys/Block = ',Max_Keys);
  945.    writeln(ofil,'Root =',Ndx_Root:5,'   Next Block Available:',Next_Blk:5);
  946.    WorkNode := tbLink^.FetchTop;
  947.    writeln(ofil,'Data records are at Level ',tbLink^.Count,
  948.                 ' in the hierarchy.');
  949.    RPag := 1;
  950.    while RPag <> Next_Blk do
  951.    begin
  952.       WorkNode := tbLink^.NodeGet(RPag);
  953.       System.write(ofil,RPag:2,'  [',Ndx_Data.Entry_Ct:2,']');
  954.       CurrElmt :=  tbLink^.Elements[0];
  955.       recnode := not WorkNode^.nonLeaf;
  956.       k := WorkNode^.ItemCount;
  957.       v := 1;
  958.       i := 1;
  959.       while (i <= k) do
  960.       begin
  961.          CurrElmt :=  tbLink^.Elements[i-1];
  962.          with CurrElmt^ do
  963.          begin
  964.             System.write(ofil,'':v,Block_Ax:5);
  965.             v := 9;
  966.             if (i = k) and not recnode then System.write(ofil,'    0 - empty')
  967.             else
  968.                begin
  969.                   System.write(ofil,Recrd_Ax:5,' ');
  970.                   if ixKey_Typ <> 'C' then
  971.                      System.write(ofil,CnvrtDouble(Char_Fld))
  972.                   else
  973.                      for j := 1 to Key_Lgth do
  974.                         System.write(ofil,Char_Fld[j]);
  975.                end;
  976.          WRITELN(OFIL);
  977.          end;
  978.          inc(i);
  979.       end;
  980.       writeln(ofil);
  981.       inc(RPag);
  982.    end;
  983.    Ndx_Flush;
  984.    System.Close(ofil);
  985. end;
  986.  
  987.  
  988. Function GSO_IndexFile.KeyLocRec (rec : longint) : boolean;
  989. var
  990.    lr : longint;
  991. begin
  992.    if (rec = ixKey_Num) and (tbLink^.Count > 0) then
  993.    begin                              {Exit if already at the record}
  994.       KeyLocRec := true;
  995.       exit;
  996.    end;
  997.    lr := KeyRead(Top_Record);
  998.    while (not ixEOF) and (lr <> rec) do lr := KeyRead(Next_Record);
  999.    if (ixEOF) then KeyLocRec := false
  1000.       else KeyLocRec := true;
  1001. end;
  1002.  
  1003.  
  1004. FUNCTION  GSO_IndexFile.KeyRead(a : longint) : longint;
  1005. var
  1006.    elem : GSP_InxElement;
  1007.    h_str : ixKeyString;
  1008.    h_num : longint;
  1009. begin
  1010.    RNum := a;
  1011.    if ((a = Next_Record) or (a = Prev_Record)) and
  1012.       (ixKey_Num = 0) then RNum := Top_Record;
  1013.                                       {if first time through, use Top_Record}
  1014.                                       {command instead}
  1015.    if ((RNum = Next_Record) or (RNum = Prev_Record)) and
  1016.       (tbLink^.Count = 0) then
  1017.    begin
  1018.       h_str := ixKey_St;
  1019.       h_num := ixKey_Num;
  1020.       ixKey_Num := KeyFind(h_str);
  1021.       if ixKey_Num <> 0 then
  1022.       begin
  1023.          while (ixKey_Num < h_num) and (ixKey_St = h_str) do
  1024.          begin
  1025.             elem := tbLink^.FetchNext;
  1026.             if elem <> nil then
  1027.             begin
  1028.                move(elem^.Char_Fld,ixKey_St[1],Key_Lgth);
  1029.                ixKey_St[0] := chr(Key_Lgth);
  1030.                ixKey_Num := elem^.Recrd_Ax;
  1031.             end
  1032.                else h_num := 0;
  1033.          end;
  1034.       end
  1035.       else
  1036.       begin
  1037.          if ixEOF then
  1038.          begin
  1039.             elem := tbLink^.FetchPrev;
  1040.             if elem <> nil then
  1041.             begin
  1042.                move(elem^.Char_Fld,ixKey_St[1],Key_Lgth);
  1043.                ixKey_St[0] := chr(Key_Lgth);
  1044.                ixKey_Num := elem^.Recrd_Ax;
  1045.             end;
  1046.             ixEOF := false;
  1047.          end;
  1048.       end;
  1049.       if ixKey_Num <> h_num then RNum := Same_Record;
  1050.    end;
  1051.    ixBOF := false;
  1052.    ixEOF := false;                   {End-of-File initially set false}
  1053.    case RNum of                       {Select KeyRead Action}
  1054.  
  1055.       Next_Record : begin
  1056.                        elem := tbLink^.FetchNext;
  1057.                        if elem = nil then ixEOF := true;
  1058.                     end;
  1059.  
  1060.       Prev_Record : begin
  1061.                        elem := tbLink^.FetchPrev;
  1062.                        if elem = nil then ixBOF := true;
  1063.                     end;
  1064.  
  1065.       Top_Record  : begin
  1066.                        elem := tbLink^.FetchTop;
  1067.                        if elem = nil then ixEOF := true;
  1068.                     end;
  1069.  
  1070.  
  1071.       Bttm_Record : begin
  1072.                        elem := tbLink^.FetchBttm;
  1073.                        if elem = nil then ixBOF := true;
  1074.                     end;
  1075.  
  1076.       Same_Record : elem := tbLink^.FetchCurr;
  1077.  
  1078.       else          elem := nil;      {if no valid action, return zero}
  1079.    end;
  1080.    CurrNode := tbLink^.Items^[tbLink^.Count-1];
  1081.    if elem <> nil then
  1082.    begin
  1083.       RNum := elem^.Recrd_Ax;
  1084.       move(elem^.Char_Fld,ixKey_St[1],Key_Lgth);
  1085.       ixKey_St[0] := chr(Key_Lgth);
  1086.       ixKey_Num := RNum;
  1087.       CurrElmt := elem;
  1088.    end
  1089.    else
  1090.    begin
  1091.       RNum := 0;
  1092.       CurrElmt := tbLink^.Elements[CurrNode^.ItemCount];
  1093.    end;
  1094.    KeyRead := RNum;                   {Return RNum}
  1095. end;
  1096.  
  1097. Procedure GSO_IndexFile.KeySort(kl : integer; sa : SortStatus);
  1098. begin
  1099.    ixColl := New(GSP_IndxColl, Init(kl, sa));
  1100. end;
  1101.  
  1102. Procedure GSO_IndexFile.KeyUpdate(rec : longint; st : string; Apnd : boolean);
  1103. var
  1104.    em_hold : boolean;                 {holds ExactMatch flag during this}
  1105.    old_key : ixKeyString;
  1106.    old_num : longint;
  1107.    shrrsl  : word;
  1108.    icr     : word;
  1109.  
  1110. {
  1111.    This routine deletes the current entry by overlaying the remaining entries
  1112.    over the entry location, and then decrementing the entry count.  The
  1113.    routine then saves the nodes back to disk, deleting nodes where needed.
  1114.    Node objects are released as they are written.
  1115. }
  1116.    Procedure KeyDelete;
  1117.    begin
  1118.       tbLink^.NodeEntryDelete(CurrNode^.Etry_No);
  1119.       tbLink^.WriteAllNodes(AtLeaf);
  1120.    end;
  1121.  
  1122. {  This routine inserts an entry by making room in the current data array
  1123.    and inserting the new entry.  The entry count is then incremented.  The
  1124.    routine then saves the nodes back to disk, expanding nodes where needed.
  1125.    Node objects are released as they are written.  The routine will first
  1126.    find the record that is just after the record key.  This is necessary
  1127.    to ensure a new duplicate key is properly inserted after any existing
  1128.    matching keys.
  1129. }
  1130.    Procedure KeyInsert;
  1131.    var
  1132.       nu_key : longint;
  1133.    begin
  1134.       nu_key := KeyFind(st);          {Find a matching key.}
  1135.       if nu_key <> 0 then             {If there is a match, continue looking}
  1136.          while (ixKey_St = Work_Key) and (not ixEOF) do
  1137.             nu_key := KeyRead(Next_Record);
  1138.       ixKey_St := PadR(Work_Key,Key_Lgth);
  1139.       ixKey_Num := rec;
  1140.       tbLink^.NodeEntryInsert(CurrNode^.Etry_No,ixKey_St,0,rec);
  1141.       tbLink^.WriteAllNodes(AtLeaf);
  1142.       if not ixFollowKey then
  1143.       begin
  1144.          ixKey_St := old_key;
  1145.          ixKey_Num := old_num;
  1146.       end;
  1147.    end;
  1148.  
  1149.  
  1150. begin
  1151.    old_key := ixKey_St;
  1152.    old_num := ixKey_Num;
  1153.    Work_Key := Ndx_AdjVal(st);        {Set key comparison value}
  1154.    em_hold := dbExactMatch;
  1155.    dbExactMatch := true;
  1156.    if dfFileShrd then
  1157.    begin
  1158.       icr := 0;
  1159.       repeat
  1160.          shrrsl := LockRec(0,NdxBlokSize);
  1161.          inc(icr);
  1162.       until (shrrsl = 0) or (icr > AccessTries);
  1163.       if shrrsl <>  0 then
  1164.       begin
  1165.          Error(dosAccessDenied, ndxKeyUpdateError);
  1166.          exit;
  1167.       end;
  1168.    end;
  1169.    if Apnd then                   {Tests for Append vs Update}
  1170.       KeyInsert
  1171.    else
  1172.    begin
  1173.       if KeyLocRec(rec) then
  1174.       begin
  1175.          if Work_Key <> ixKey_St then
  1176.          begin
  1177.             KeyDelete;
  1178.             KeyInsert;
  1179.          end;
  1180.       end;
  1181.    end;
  1182.    if dfFileShrd then shrrsl := UnLock;
  1183.    dbExactMatch := em_hold;
  1184. end;
  1185.  
  1186.  
  1187.  
  1188. function GSO_IndexFile.Ndx_AdjVal(st : string): string;
  1189. var
  1190.    Work_Key : string;
  1191.    Work_Num : gsDouble;
  1192.    dt       : longint;
  1193.    rl       : word;
  1194. begin
  1195.    if ixKey_Typ = 'C' then
  1196.    begin                              {if a character key field then --}
  1197.       if dbExactMatch then
  1198.          Work_Key := PadR(st,Key_Lgth)
  1199.       else
  1200.          Work_Key := st;
  1201.    end
  1202.    else
  1203.    begin
  1204.       if ixKey_Typ = 'D' then
  1205.       begin
  1206.          dt := GS_Date_Juln(st);
  1207.          str(dt,st);
  1208.       end;
  1209.       MakeDouble(st,Work_Num,rl);
  1210.       if rl <> 0 then Error(tpFloatPointInvld, ndxNdx_AdjValError);
  1211.       move(Work_Num, Work_Key[1], 8);
  1212.       Work_Key[0] := #8;
  1213.    end;
  1214.    Ndx_AdjVal := Work_Key;
  1215. end;
  1216.  
  1217. Procedure GSO_IndexFile.Ndx_Close;
  1218. begin
  1219.    Ndx_Flush;
  1220.    Dispose(tbLink, Done);
  1221.    Close;
  1222. end;
  1223.  
  1224. Procedure GSO_IndexFile.Ndx_Flush;
  1225. begin
  1226.    Flush;
  1227.    tbLink^.ReleaseAllNodes;
  1228.    ixKey_St := '';
  1229.    ixKey_Num := 0;
  1230. end;
  1231.  
  1232. Procedure GSO_IndexFile.Ndx_GetHdr;
  1233. begin
  1234.    Read(0,Ndx_Hdr,NdxBlokSize);
  1235. end;
  1236.  
  1237. Function GSO_IndexFile.Ndx_NextBlock : longint;
  1238. var
  1239.    rl : word;
  1240. begin
  1241.    Ndx_NextBlock := FileSize div NdxBlokSize;
  1242. end;
  1243.  
  1244. Procedure GSO_IndexFile.Ndx_PutHdr;
  1245. begin
  1246.    Ndx_Hdr.Next_Blk := Ndx_NextBlock;
  1247.    Write(0,Ndx_Hdr,NdxBlokSize);
  1248. end;
  1249.  
  1250. Function GSO_IndexFile.Ndx_Root : Longint;
  1251. begin
  1252.    if dfFileShrd then Ndx_GetHdr;
  1253.    Ndx_Root := Ndx_Hdr.Root;
  1254. end;
  1255.  
  1256. Procedure GSO_IndexFile.WriteStatus(RNum : longint);
  1257. begin
  1258. end;
  1259.  
  1260. end.
  1261. {-----------------------------------------------------------------------------}
  1262.                                       END
  1263.  
  1264.  
  1265.